00050	(THVSETQ (THV BT)NIL)
00060	(THVSETQ(THV TXV)NIL)
00070	
00080	
00100	(DEFPROP INCGCTR
00200	   (LAMBDA(B)
00300	      (PROG ()
00400		(COND((AND(EQ @THCONSE(CAR B))(THV WF))
00500		      (THSETQ(THV GCTR)(ADD1(THV GCTR)))))
00600		(RETURN T)  ))
00700	EXPR)
00800	
00900	
01000	(DEFPROP TRACEBIND
01100	   (LAMBDA(TX TY)
01200	      (PROG(BX BY TXX TTL)
01219		(COND((NOT(AND(THV WF)BTSW(THV TXV)))(RETURN NIL)))
01225		(COND((THVAR(CAR(THV TXV)))(SETQ TXX(CAR(THV TXV))))
01230		     (T(SETQ TXX TX)))
01400		(COND((THVAR TY)(SETQ BY(CADR(THGAL TY THALIST)))))
01500		(COND((THVAR TXX)(SETQ BX(CADR(THGAL TXX THOLIST)))))
01600		(COND(BY(GO TR5))
01700		     ((EQ BX @THUNASSIGNED)(GO TR3))
01800		     (T(GO TR6)))
01900	TR3	(SETQ TTL(FINDTL(LIST(CADR TXX)(THV LCTR))T(THV BT)))
02000		(COND(TTL(THSETQ(THV BT)(CONS(CONS(LIST(LIST(CADR TXX)(THV LCTR))TY)TTL)(THV BT))))
02050		     (T(GO TR6)))
02100		(SETQ TTL(FINDTL TY NIL(THV BT)))
02200		(COND(TTL(THSETQ(THV BT)(CONS(CONS(LIST(LIST(CADR TXX)(THV LCTR))TY)TTL)(THV BT))))
02300		     (T(THSETQ(THV BT)(CONS(LIST(LIST(LIST(CADR TXX)(THV LCTR))TY))(THV BT)))))
02400		(GO TR6)
02500	TR5	(COND((NOT(EQ BY @THUNASSIGNED))(GO TR6))
02600		     ((NOT BX)(GO TR4))
02700		     ((EQ BX @THUNASSIGNED)(GO TR2)) )
02800	TR1	(SETQ TTL(FINDTL(LIST(CADR TXX)(NTHV @LCTR 1 THALIST))T(THV BT)))
02900		(COND(TTL(THSETQ(THV BT)(CONS(APPEND(LIST(LIST(LIST(CADR TY)(ADD1(THV GCTR)))BX)
03000							 (LIST(LIST(CADR TY)(ADD1(THV GCTR)))(LIST(CADR TXX)(NTHV @LCTR 1 THALIST))))
03100						     TTL)(THV BT) )))
03200		     (T(THSETQ(THV BT)(CONS(LIST(LIST(LIST(CADR TY)(ADD1(THV GCTR)))BX)
03300						(LIST(LIST(CADR TY)(ADD1(THV GCTR)))(LIST(CADR TXX)(NTHV @LCTR 1 THALIST)))
03400						(LIST(LIST(CADR TXX)(NTHV @LCTR 1 THALIST))BX))(THV BT)))))
03500		(GO TR6)
03600	TR2	(SETQ TTL(FINDTL(LIST(CADR TXX)(NTHV @LCTR 1 THALIST))T(THV BT)))
03700		(COND(TTL(THSETQ(THV BT)(CONS(CONS(LIST(LIST(CADR TY)(ADD1(THV GCTR)))(LIST(CADR TXX)(NTHV @LCTR 1 THALIST)))
03800						  TTL)(THV BT))))
03900		     (T(THSETQ(THV BT)(CONS(LIST(LIST(LIST(CADR TY)(ADD1(THV GCTR)))(LIST(CADR TXX)(NTHV @LCTR 1 THALIST))))
04000					    (THV BT)))))
04100		(GO TR6)
04200	TR4	(THSETQ(THV BT)(CONS(LIST(LIST(LIST(CADR TY)(ADD1(THV GCTR)))TXX))(THV BT)))
04250	TR6	(THSETQ(THV TXV)(CDR(THV TXV)) T T)
04300		(RETURN NIL)   ))
04400	EXPR)
04500	
04600	
04700	
04800	
04900	(DEFPROP FINDTL
05000	  (LAMBDA(E FS B)
05100		(COND((NULL B)NIL)
05200		     ((AND FS(EQUAL E(CAAAR B)))(CAR B))
05300		     ((AND(NOT FS)(EQUAL E(CADAAR B))(NOT(NUMBERP(CADR(EXPLODE(CAAAAR B))))))(CAR B))
05400		     (T(FINDTL E FS(CDR B))))   )
05500	EXPR)
05600	
05700	
05800	
05900	
06000	
06100	(DEFPROP SAVAR
06200	   (LAMBDA(THA1)
06300	      (PROG NIL
06350		(COND((AND(NULL SSW) CT)(RPLACA(CAR CT)(CONS(COND((ATOM(CAAR CT))(CAAR CT))(T(CAAAR CT)))(LIST THA2)))))
06400		(COND((AND(THV WF)BTSW(NOT(NUMBERP THA1)))(THSETQ(THV TXV)(MAPCAR(FUNCTION ETHEV)THA1))))   ))
06500	EXPR)
06600	
06605	
06608	(DEFPROP SIMPLE
06611	   (LAMBDA(THA2B)
06614		(COND((NULL SRULES)THA2B) 
06615		     ((NULL THA2B)NIL)
06617		     ((OR(ATOM(CAR THA2B))(EQ @THV(CAAR THA2B)))
06620		      (CONS(CAR THA2B)(SIMPLE(CDR THA2B))))
06623		     (T(CONS(SIMPLE1(CAR THA2B))(SIMPLE(CDR THA2B))))))
06626	EXPR)
06629	
06632	
06635	(DEFPROP SIMPLE1
06638	   (LAMBDA(X)
06641	      (PROG(TX TR)
06644		(SETQ TR SRULES)
06647		(SETQ TX X)
06650	SI3	(SETQ TX(SIMPLE2 TX(CAR TR)))
06651		(SETQ TX(SIMPLE2 TX(CAR TR)))
06653		(SETQ TR(CDR TR))
06656		(COND(TR (GO SI3)))
06659		(RETURN TX)  ))
06662	EXPR)
06665	
06668	
06671	(DEFPROP SIMPLE2
06674	   (LAMBDA(X R)
06677		(COND((OR(ATOM X)(EQ @THV(CAR X))(AND(EQ @#(CAR X))
06678						   (OR(ATOM(CADDR X))(NULL(CDADDR X))))(NULL(CDR X)))X)
06680		     ((AND(NULL(CDDR X))(EQ(CAR X)(CAAR R))(NOT(OR(ATOM(CADR X))(NULL(CADADR X))))(EQ(CAADR X)(CAADAR R)))
06683		      (COND((ATOM(CADR R))(COND((EQ(CAR X) @CAR*)(SIMPLE2(CADADR X)R))((EQ(CAR X) @CDR*)(SIMPLE2(CAR(CDDADR X))R))(T X)))
06686			   (T(CONS(CAADR R)(LIST(SIMPLE2(CADADR X)R))))))
06687		     ((AND(EQ(CAR X)(CAAR R))(EQ @#(CAADR X))(NOT(ATOM(CADDAR(CDR X))))(EQ(CAADDR(CADR X))(CAADAR R)))
06688		      (COND((ATOM(CADR R))(SIMPLE2(CADADR(CDADR X))R))(T(CONS(CAADR R)(LIST(SIMPLE2(CADADR(CDADR X))R))))))
06690		     ((AND(EQUAL(CAR X)(CAAR R))(NOT(ATOM(CADR X)))(CDDAR R)(CDDR X)
06691		          (EQUAL(CAADR X)(CAADAR R))(EQUAL(CAR(CDDADR X))(CADDR X)))
06692		      (CADADR X))
06693		     ((CDDR X) X)
06697		     (T(CONS(CAR X)(LIST(SIMPLE2(CADR X)R))))))
06699	EXPR)
06700	
06800	(DEFPROP ETHEV
06900	   (LAMBDA(ATHA1)
07000		(COND((EQ(CAR ATHA1)@THEV)(THVAL(CADR ATHA1)THALIST))
07100		     (T ATHA1))  )
07200	EXPR)
07300	
07400	
07500	
07600	(DEFPROP NTHV
07700	   (LAMBDA(K N L)
07800		(COND((NULL L)(PRINT @LCTR_NOT_BOUND))
07900		     ((AND(EQ K(CAAR L))(ZEROP N))(CADAR L))
08000		     ((EQ K(CAAR L))(NTHV K(SUB1 N)(CDR L)))
08100		     (T(NTHV K N(CDR L))))  )
08200	EXPR)
08300	
08400	
08500	(DEFPROP COLLECTDB
08600	   (LAMBDA(THY)
08650		(COND((AND (THV ULS)THY(NULL SSW)CT 
08700			   (NOT(SUBSTP(CDAR CT)(CADR THE))))
08750		      (COND((EQ @IF(CADAR CT))
08755	                    (RPLACA CT(CONS(CAAR CT)(APPEND(CONSIFL(CDAR CT))(APPEND(FIXBADDBMATCH(CADR THE)THY)
08756							     (CDRIFL(CDAR CT)))))) )
08757			   (T(RPLACA CT(CONS(CAAR CT)(APPEND(FIXBADDBMATCH(CADR THE)THY)
08758							     (CDAR CT)))))))
08760	  	     ((AND(THV ULS)THY(NULL SSW)CT)
08770		      (COND((EQ @IF(CADAR CT))
08810			    (RPLACA CT(CONS(CAAR CT)(APPEND(CONSIFL(CDAR CT))(UPDATLIT(CDRIFL(CDAR CT))(CADR THE)
08812											  (LIST(THVARSUBST(CADR THE))))))))
08815			   (T(RPLACA CT(CONS(CAAR CT)(UPDATLIT(CDAR CT)(CADR THE)(LIST(THVARSUBST(CADR THE)))))))))))
08850	EXPR)
08950	
08951	
08953	
08956	(DEFPROP CONSIFL
08959	   (LAMBDA(IFL)
08962		(COND((NULL IFL)NIL)((ATOM(CAR IFL))(CONS @IF(CONSIFL(CDR IFL))))
08965		     (T NIL))   )
08968	EXPR)
08971	
08974	
08977	(DEFPROP CDRIFL
08980	   (LAMBDA(IFL)
08983	      	(COND((NULL IFL)NIL)((ATOM(CAR IFL))(CDRIFL(CDR IFL)))
08986		     (T IFL))  )
08989	EXPR)
08992	
08995	
09050	
09053	
09056	(DEFPROP FIXBADDBMATCH
09059	   (LAMBDA(CTHE CTHY)
09062	      (PROG(TTHY)
09065		(SETQ TTHY(FIXDB1(THVARSUBST CTHE)CTHY))
09068		(COND((NULL TTHY)(RETURN NIL)))
09071		(RETURN(LIST(CONS CTHE TTHY)))   ))
09074	EXPR)
09077	
09080	
09083	(DEFPROP FIXDB1
09086	   (LAMBDA(VTHE VTHY)
09089		(COND((NULL VTHY)NIL)
09092		     ((OR(SUBSTP VTHE @THV)(EQUAL VTHE(CAAR VTHY)))VTHY)
09095		     (T(FIXDB1 VTHE(CDR VTHY))))   )
09098	EXPR)
09101	
09104	
10100	
10200	
10300	(DEFPROP UPDATLIT
10400	   (LAMBDA(GHITS X Y)
10500		(COND((NULL GHITS)NIL)
10600		     ((EQUAL X(CAAR GHITS))
10700		      (APPEND(UPDATLIT1(CAAR GHITS)(CDAR GHITS)Y)(CDR GHITS)))
10800		     (T(CONS(CAR GHITS)(UPDATLIT(CDR GHITS)X Y))))  )
10900	EXPR)
11000	
11100	
11200	(DEFPROP UPDATLIT1
11300	   (LAMBDA(GTHE AGHITS Y)
11400		(COND((NULL AGHITS)NIL)
11500		     ((EQUAL Y(CAR AGHITS))
11600		      (LIST(CONS GTHE AGHITS)))
11700		     (T(UPDATLIT1 GTHE(CDR AGHITS)Y)))  )
11800	EXPR)
11900	
12000	
12100	(DEFPROP STEPT
12200	   (LAMBDA NIL
12350		(COND((AND 
12352			(NOT(EQ(CAR THE)@THASSERT))
12355			THVALUE
12357			(NULL SSW)
12360			CT
12365			(CDAR CT)
12370			(OR
12375				(EQUAL THE @(THFAIL))
12380				(AND
12385					(EQ(CAR THE)@THGOAL)
12390					(NOT(EQUAL(THVARSUBST(CADR THE))(CAR THVALUE)))))
12395			(NOT(ATOM(CADADR THTREE)))
12397			(ATOM(CAR(CADADR THTREE))))
12400		      (COND((EQ @IF(CADAR CT))
12450			    (RPLACA CT(CONS(CAAR CT)(APPEND(CONSIFL(CDAR CT))(UPDATLIT(CDRIFL(CDAR CT))(CADADR THTREE)THVALUE)))))
12452			   (T(RPLACA CT(CONS(CAAR CT)(UPDATLIT(CDAR CT)(CADADR THTREE)THVALUE))))))))
12500	EXPR)
12600